home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / drdobbs / 1988 / 07 / popups / popdemo.pas < prev    next >
Pascal/Delphi Source File  |  1988-05-23  |  9KB  |  348 lines
  1. «LM10»«AL1»«RHA
  2. «VA$fi»     «DAmm/dd/yy»     «TM»     Galley «PN» of «FP»
  3.  
  4. »«PT1»
  5. Program popdemo;
  6.  
  7.   (* Demonstrates use of POPUPS unit *)
  8.  
  9. USES crt, popups;
  10.  
  11. (* Define menubar *)
  12.  
  13. CONST MainMenu : menuRec = (
  14.             row : 1; interval : 26; fore : White; back : Green);
  15.       MainMenuText : string [14] = 'Demos~Run~Thru';
  16.  
  17. (* Define pull-down menus *)
  18.  
  19.       DemoMenu : popRec = (
  20.             left : 1; top : 2; right : 14; bottom : 6; style : 1;
  21.             normal : LightGray; hilite : LightGray;
  22.             normback : Blue; hiback : Magenta; border : Cyan);
  23.       DemoMenuText : string [39] =
  24.             'Show file~Walk popup~Graphics';
  25.  
  26.       RunMenu : popRec = (
  27.             left : 27; top : 2; right : 39; bottom : 5; style : 1;
  28.             normal : LightGray; hilite : LightGray;
  29.             normback : Blue; hiback : Magenta; border : Cyan);
  30.       RunMenuText : string [19] = 'All demos~Exit menu';
  31.  
  32.       QuitMenu : popRec = (
  33.             left : 53; top : 2; right : 68; bottom : 5; style : 1;
  34.             normal : LightGray; hilite : LightGray;
  35.             normback : Blue; hiback : Magenta; border : Cyan);
  36.       QuitMenuText : string [22] = 'Quit program~Exit menu';
  37.  
  38. (* Define windows for demos *)
  39.       FileWindow : popRec = (
  40.             left : 2; top : 4; right : 75; bottom : 25; style : 2;
  41.             normal : Brown; hilite : 0;
  42.             normback : Black; hiback : 0; border : Yellow);
  43.  
  44.       Walker : popRec = (
  45.             left : 66; top : 1; right : 80; bottom : 6; style : 2;
  46.             normal : Red; hilite : 0;
  47.             normback : LightGray; hiback : 0; border : Red);
  48.       WalkerText : string [46] =
  49.             'This pop-up~moves down~by changing~top, bottom';
  50.  
  51.       SalesChart : popRec = (
  52.             left : 51; top : 9; right : 72; bottom : 22; style : 2;
  53.             normal : Cyan; hilite : 0;
  54.             normback : LightGray; hiback : 0; border : Red);
  55.  
  56. (* ------------------------ DEMO ROUTINES ------------------------- *)
  57.  
  58. PROCEDURE ShowFile;
  59.  
  60.       { List the source for this program in FileWindow }
  61.       { Leave window open afterwards }
  62.  
  63. VAR   ThisFile : TEXT;
  64.       Line     : string [80];
  65.  
  66. BEGIN
  67.   popShow (FileWindow);
  68.   Assign (ThisFile, 'POPDEMO.PAS');
  69.   Reset (ThisFile);
  70.   WHILE NOT eof (ThisFile) DO BEGIN
  71.     Readln (ThisFile, line);
  72.     Writeln (Line);
  73.   END;
  74.   Close (ThisFile);
  75. END;
  76.  
  77. (* -------------------------- *)
  78.  
  79. PROCEDURE WalkPopup;
  80.  
  81.       { Walk a pop-up down the right side of the display }
  82.       { Moves by successively incrementing top and bottom }
  83.  
  84. VAR   TopRow : INTEGER;
  85.  
  86. BEGIN
  87.   popShow (Walker);
  88.   FOR TopRow := 2 to 19 DO BEGIN
  89.     popErase (Walker);
  90.     Walker.top    := TopRow;
  91.     Walker.bottom := TopRow + 5;
  92.     popShow (Walker);
  93.   END;
  94. END;
  95.  
  96. (* -------------------------- *)
  97.  
  98. PROCEDURE TextChart;
  99.  
  100.       { Simulate a sales results chart using simple text graphics }
  101.  
  102. CONST block = #219;
  103.  
  104.   PROCEDURE DrawBar (column, height : INTEGER);
  105.   VAR   y : INTEGER;
  106.   BEGIN
  107.     FOR y := 10 DOWNTO (10 - height) DO BEGIN
  108.       Gotoxy (column, y);
  109.       Write (block);
  110.     END;
  111.   END;
  112.  
  113. BEGIN
  114.   popShow (SalesChart);
  115.   popCenter (SalesChart, 1, 'Sales Results');
  116.   TextColor (Green);
  117.   Gotoxy (2, 12); Write ('Projected');
  118.   DrawBar ( 2, 6);
  119.   DrawBar ( 7, 7);
  120.   DrawBar (12, 5);
  121.   DrawBar (17, 6);
  122.   TextColor (Red);
  123.   Gotoxy (14, 12); Write ('Actual');
  124.   DrawBar ( 4, 5);
  125.   DrawBar ( 9, 6);
  126.   DrawBar (14, 7);
  127.   DrawBar (19, 8);
  128. END;
  129.  
  130. (* ----------------------- CONTROL ROUTINES ----------------------- *)
  131.  
  132. FUNCTION DemoResult : CHAR;
  133.  
  134.     { Pull down and act on Demos Menu }
  135.  
  136. VAR   key, wait : CHAR;
  137.       pick      : INTEGER;
  138.       exiting   : BOOLEAN;
  139.  
  140. BEGIN
  141.   pick := 1;
  142.   exiting := FALSE;
  143.   popShow (DemoMenu);
  144.   popHilite (DemoMenu, 1);
  145.   REPEAT
  146.  
  147.     { Get menu selection }
  148.     key := Keystroke;
  149.     popNormal (DemoMenu, pick);                  { remove hilite bar }
  150.     CASE key OF
  151.       'S'        : pick := 1;
  152.       'W'        : pick := 2;
  153.       'G'        : pick := 3;
  154.       DownCursor : BEGIN
  155.                      Inc (pick);
  156.                      IF pick > 3 THEN pick := 1;   { Wrap to top row }
  157.                    END;
  158.       UpCursor   : BEGIN
  159.                      Dec (pick);
  160.                      IF pick = 0 THEN pick := 3;    { Wrap to bottom }
  161.                    END;
  162.       LeftCursor : exiting := TRUE;
  163.       RiteCursor : exiting := TRUE;
  164.       Enter      : CASE pick OF        { Selection by cursor + enter }
  165.                      1: key := 'S';
  166.                      2: key := 'W';
  167.                      3: key := 'G';
  168.                    END;
  169.       ELSE exiting := TRUE;                    { Pass back keystroke }
  170.     END;
  171.     popHilite (DemoMenu, pick);                    { hilite new pick }
  172.  
  173.     { Do demo if selected }
  174.     IF key IN ['S', 'W', 'G'] THEN BEGIN
  175.       CASE key OF
  176.         'S': BEGIN
  177.                ShowFile;
  178.                wait := ReadKey;
  179.                popErase (FileWindow);
  180.              END;
  181.         'W': BEGIN
  182.                WalkPopup;
  183.                wait := ReadKey;
  184.                popErase (Walker);
  185.              END;
  186.         'G': BEGIN
  187.                TextChart;
  188.                wait := ReadKey;
  189.                popErase (SalesChart);
  190.              END;
  191.       END;
  192.     END;
  193.   UNTIL exiting;
  194.   popErase (DemoMenu);
  195.   DemoResult := key;
  196. END;
  197.  
  198. (* -------------------------- *)
  199.  
  200. FUNCTION RunResult : CHAR;
  201.  
  202.       { Pull down and act on Run Menu }
  203.  
  204. VAR   key, wait : CHAR;
  205.       pick      : INTEGER;
  206.       exiting   : BOOLEAN;
  207.  
  208. BEGIN
  209.   pick := 1;
  210.   exiting := FALSE;
  211.   popShow (RunMenu);
  212.   popHilite (RunMenu, 1);
  213.   REPEAT
  214.     key := Keystroke;                                { remove hilite }
  215.     popNormal (RunMenu, pick);
  216.     CASE key OF
  217.       DownCursor : IF pick = 1 THEN pick := 2 ELSE pick := 1;
  218.       UpCursor   : IF pick = 1 THEN pick := 2 ELSE pick := 1;
  219.       'E'        : exiting := TRUE;
  220.       LeftCursor : exiting := TRUE;
  221.       RiteCursor : exiting := TRUE;
  222.       Enter      : IF pick = 1 THEN key := 'A'
  223.                    ELSE BEGIN
  224.                      exiting := TRUE;
  225.                      key := 'E';
  226.                    END;
  227.       ELSE exiting := TRUE;                    { Pass back keystroke }
  228.     END;
  229.     popHilite (RunMenu, pick);                     { hilite new pick }
  230.  
  231.     IF key = 'A' THEN BEGIN                    { Do all demos on 'A' }
  232.       ShowFile;
  233.       TextChart;
  234.       WalkPopup;
  235.       Wait := ReadKey;                           { Wait for keypress }
  236.       popErase (Walker);                       { Retreat thru popups }
  237.       popErase (SalesChart);
  238.       popErase (FileWindow);
  239.     END;
  240.  
  241.   UNTIL exiting;
  242.   popErase (RunMenu);
  243.   RunResult := key;
  244. END;
  245.  
  246. (* -------------------------- *)
  247.  
  248. FUNCTION QuitResult : CHAR;
  249.  
  250.       { Pull down and act on Quit Menu }
  251.  
  252. VAR   key     : CHAR;
  253.       pick    : INTEGER;
  254.       exiting : BOOLEAN;
  255.  
  256. BEGIN
  257.   pick := 1;
  258.   exiting := FALSE;
  259.   popShow (QuitMenu);
  260.   popHilite (QuitMenu, 1);
  261.   REPEAT
  262.     key := Keystroke;
  263.     popNormal (QuitMenu, pick);
  264.     CASE key OF
  265.       DownCursor : IF pick = 1 THEN pick := 2 ELSE pick := 1;
  266.       UpCursor   : IF pick = 1 THEN pick := 2 ELSE pick := 1;
  267.       'Q'        : exiting := TRUE;
  268.       'E'        : exiting := TRUE;
  269.       LeftCursor : exiting := TRUE;
  270.       RiteCursor : exiting := TRUE;
  271.       Enter      : BEGIN
  272.                      IF pick = 1 THEN key := 'Q' ELSE key := 'E';
  273.                      exiting := TRUE;
  274.                    END;
  275.       ELSE exiting := TRUE;                    { Pass back keystroke }
  276.     END;
  277.     popHilite (QuitMenu, pick);
  278.   UNTIL exiting;
  279.   popErase (QuitMenu);
  280.   QuitResult := key;
  281. END;
  282.  
  283. (* -------------------------- *)
  284.  
  285. PROCEDURE DoMainMenu;
  286.  
  287.       { Manages pull-down menu selection }
  288.  
  289. TYPE MenuUp = (Demos, Run, Thru);
  290.  
  291. VAR  quitting : BOOLEAN;
  292.      MMsel    : MenuUp;
  293.      UserKey  : CHAR;
  294.  
  295. BEGIN
  296.   Quitting := FALSE;
  297.   MMsel    := Demos;
  298.   REPEAT
  299.     UserKey := chr (0);
  300.  
  301.     { Act on selected pulldown }
  302.     CASE MMsel OF
  303.       Demos : UserKey := DemoResult;
  304.       Run   : UserKey := RunResult;
  305.       Thru  : UserKey := QuitResult;
  306.     END;
  307.  
  308.     { Act on returned keystroke }
  309.     CASE UserKey OF
  310.       'E'       : MMsel := Demos;
  311.       'D'       : MMsel := Demos;
  312.       'R'       : MMsel := Run;
  313.       'T'       : MMsel := Thru;
  314.       'Q'       : Quitting := TRUE;
  315.       LeftCursor: IF MMsel = Demos THEN
  316.                     MMsel := Thru
  317.                   ELSE
  318.                     Dec (MMsel);
  319.       RiteCursor: IF MMsel = Thru THEN
  320.                     MMsel := Demos
  321.                   ELSE
  322.                     Inc (MMsel);
  323.       END;
  324.   UNTIL quitting;
  325. END;
  326.  
  327. (* ---------------------------------------------------------------- *)
  328.  
  329. BEGIN  (*** Main program ***)
  330.  
  331.   { Initialize object text pointers }
  332.   MainMenu.choice   := @MainMenuText;
  333.   DemoMenu.contents := @DemoMenuText;
  334.   RunMenu.contents  := @RunMenuText;
  335.   QuitMenu.contents := @QuitMenuText;
  336.   Walker.contents   := @WalkerText;
  337.  
  338.   { Set up screen and go }
  339.   ClrScr;
  340.   Cursoff;
  341.   showMenubar (MainMenu);
  342.   DoMainMenu;
  343.  
  344.   { Make sure cursor is on before quitting }
  345.   Curson;
  346.   ClrScr;
  347. END.
  348.